home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / dialogsUtils.tcl < prev    next >
Encoding:
Text File  |  2001-01-08  |  48.0 KB  |  1,642 lines
  1. ## -*-Tcl-*- (nowrap)
  2.  # ###################################################################
  3.  #  AlphaTcl - core Tcl engine
  4.  # 
  5.  #  FILE: "dialogsUtils.tcl"
  6.  #                                    created: 12/1/96 {5:36:49 pm} 
  7.  #                                last update: 01/09/2001 {04:46:57 AM} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <vince@santafe.edu>
  10.  #    mail: 317 Paseo de Peralta, Santa Fe, NM 87501
  11.  #     www: <http://www.santafe.edu/~vince/>
  12.  #  
  13.  # Much copyright (c) 1997-2000  Vince Darley, all rights reserved, 
  14.  # rest Pete Keleher, Johan Linde.
  15.  # 
  16.  # Reorganisation carried out by Vince Darley with much help from Tom 
  17.  # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.  
  18.  # Alpha is shareware; please register with the author using the register 
  19.  # button in the about box.
  20.  # 
  21.  # This file contains helper procedures used by the other dialogs
  22.  # code.  Most likely you will not need to call these procedures
  23.  # directly in your code, unless you are really building your own
  24.  # dialogs piece by piece.
  25.  # ###################################################################
  26.  ##
  27.  
  28. namespace eval dialog {}
  29. namespace eval global {}
  30. namespace eval flag {}
  31.  
  32. # ◊◊◊◊ Dialog sub-panes ◊◊◊◊ #
  33.  
  34. ensureset dialog::_not_global_flag ""
  35.  
  36. ## 
  37.  # -------------------------------------------------------------------------
  38.  # 
  39.  # "dialog::flag" --
  40.  # 
  41.  #  Builds a dialog-box page to be used for setting global/mode/package
  42.  #  preferences.  It can contain preferences for flags (on/off), variables,
  43.  #  list items, mode items, files, folders, apps,...
  44.  # 
  45.  # Results:
  46.  #  part of a script to generate the dialog
  47.  # 
  48.  # Side effects:
  49.  #  sets maxT to the maximum height desired by the dialog
  50.  # 
  51.  # --Version--Author------------------Changes-------------------------------
  52.  #    1.0     Pete Keleher             original
  53.  #    2.0     <vince@santafe.edu> much more sophisticated (and complex!)
  54.  # -------------------------------------------------------------------------
  55.  ##
  56. proc dialog::flag {mflags mvars {left 20} {top 40} {title {}}} {
  57.     global maxT spelling alpha::prefNames dialog::_not_global_flag mode \
  58.       includeDescriptionsInDialogs index::flags
  59.     if {$includeDescriptionsInDialogs || [info tclversion] >= 8.0} {
  60.     cache::readContents index::prefshelp
  61.     if {[info tclversion] >= 8.0} {
  62.         upvar help help
  63.     }
  64.     if {[regsub {(modeVars)?$} ${dialog::_not_global_flag} "" vprefix]} {
  65.         append vprefix ","
  66.     }
  67.     }
  68.     
  69.     set args [list]
  70.     if {$title != ""} {
  71.     lappend args "-t" $title 30 10 400 25
  72.     incr top 25
  73.     } else {
  74.     # Make room for the help button
  75.     incr top 15
  76.     }
  77.     
  78.     # if variable names are very long, switch to 2 columns
  79.     if {$includeDescriptionsInDialogs} {
  80.     set perRow 1
  81.     set width 450
  82.     } else {
  83.     if {([maxListItemLength $mflags] > 18)} {
  84.         set perRow 2
  85.         set width 225
  86.     } else {
  87.         set perRow 3
  88.         set width 150
  89.     
  90.     }
  91.     }
  92.     set height    15
  93.     
  94.     set ind 0
  95.     set l $left
  96.     foreach f $mflags {
  97.     set fname [quote::Prettify $f]
  98.     if {$spelling} {text::british fname}
  99.     if {$includeDescriptionsInDialogs} {
  100.         if {[info exists prefshelp($vprefix$f)]} {
  101.         incr top 10
  102.         eval lappend args [dialog::text \
  103.           [dialog::helpdescription $prefshelp($vprefix$f)] $l top 90]
  104.         incr top -14
  105.         } elseif {[info exists prefshelp($mode,$f)]} {
  106.         incr top 10
  107.         eval lappend args [dialog::text \
  108.           [dialog::helpdescription $prefshelp($mode,$f)] $l top 90]
  109.         incr top -14
  110.         }
  111.     }
  112.     if {[info tclversion] < 8.0} {
  113.         lappend args "-c" $fname [dialog::getFlag $f] \
  114.           $l $top [incr l $width] [expr {$top + $height}]
  115.     } else {
  116.         lappend args "-c" $fname [dialog::getFlag $f] -font 2 \
  117.           $l $top [incr l $width] [expr {$top + $height}]
  118.     }
  119.     if {[incr ind] % $perRow == 0} { set l $left ; incr top $height }
  120.     if {[info tclversion] >= 8.0} {
  121.         if {[info exists prefshelp($vprefix$f)]} {
  122.         lappend help $prefshelp($vprefix$f)
  123.         } elseif {[info exists prefshelp($mode,$f)]} {
  124.         lappend help $prefshelp($mode,$f)
  125.         } elseif {[lsearch -exact [set index::flags] $f] != -1} {
  126.         lappend help [dialog::packagehelp $f 1]
  127.         } else {
  128.         lappend help ""
  129.         }
  130.     }
  131.     }
  132.     
  133.     if {$ind} {
  134.     set top [expr {$top + 20}]
  135.     lappend args -p 100 [expr {$top + 27}] 300 [expr {$top + 28}]
  136.     } 
  137.     
  138.     dialog::buildSection $mvars top 440 $left args alpha::prefNames
  139.     incr top 30
  140.     
  141.     if {$top > $maxT} {set maxT $top}
  142.     return $args
  143. }
  144.  
  145. ## 
  146.  # -------------------------------------------------------------------------
  147.  # 
  148.  # "dialog::buildSection" --
  149.  # 
  150.  #  Build a dialog box section for a bunch of preferences.  If 'flag_check'
  151.  #  is set the prefs can be flags or vars, else just vars.
  152.  #  
  153.  #  'yvar' is a variable which contains the current y-pos in the box,
  154.  #  and should be incremented as appropriate by this procedure.
  155.  #  'width' is the width of the dialog box (default 420)
  156.  #  'l' is the left indent of all the items (default 20)
  157.  #  'dialogvar' is the variable onto which all the construction code
  158.  #  should be lappended.  If it is not given, then this proc will
  159.  #  return the items.
  160.  #  'names', if given, is an array containing textual replacements for
  161.  #  the names of the variables to be used in the box.
  162.  #  
  163.  #  A minimal call would be:
  164.  #  
  165.  #  set y 20
  166.  #  set build [dialog::buildSection [list fillColumn] y]
  167.  #  eval lappend build [dialog::okcancel 20 y]
  168.  #  set res [eval dialog -w 480 -h $y $build]
  169.  #  
  170.  # -------------------------------------------------------------------------
  171.  ##
  172. proc dialog::buildSection {vars yvar {width 420} {l 20} {dialogvar ""} {names ""} {flag_check 1}} {
  173.     global flag::list flag::type allFlags spelling alpha::colors \
  174.       includeDescriptionsInDialogs dialog::_not_global_flag mode
  175.     if {$includeDescriptionsInDialogs || [info tclversion] >= 8.0} {
  176.     cache::readContents index::prefshelp
  177.     if {[info tclversion] >= 8.0} {
  178.         upvar help help
  179.     }
  180.     }
  181.     if {[regsub {(modeVars)?$} ${dialog::_not_global_flag} "" vprefix]} {
  182.     append vprefix ","
  183.     }
  184.     upvar $yvar t
  185.     if {$dialogvar != ""} {upvar $dialogvar args}
  186.     if {$names != ""} { upvar $names name }
  187.     set height 17
  188.     set lf 135
  189.     set r [expr {$l + $width}]
  190.     set rb [expr {$r -45}]
  191.     foreach vset $vars {
  192.     if {[llength $vset] > 1} {
  193.         incr t 5
  194.         if {[lindex $vset 0] != ""} {
  195.         lappend args "-t" "[lindex $vset 0]" [expr {$l -10}] $t $r [expr {$t +15}]
  196.         incr t 20
  197.         }
  198.         set vset [lrange $vset 1 end]
  199.     }
  200.     foreach v $vset {
  201.         if {$includeDescriptionsInDialogs} {
  202.         if {[info exists prefshelp($vprefix$v)]} {
  203.             incr t 10
  204.             eval lappend args [dialog::text $prefshelp($vprefix$v) $l t 90]
  205.             incr t -14
  206.         }
  207.         }
  208.         if {[info tclversion] >= 8.0} {
  209.         if {[info exists prefshelp($vprefix$v)]} {
  210.             lappend help $prefshelp($vprefix$v)
  211.         } elseif {[info exists prefshelp($mode,$v)]} {
  212.             lappend help $prefshelp($mode,$v)
  213.         } else {
  214.             lappend help ""
  215.         }
  216.         }
  217.         
  218.         set vv [dialog::getFlag $v]
  219.         if {[info exists name($v)]} {
  220.         set vname $name($v)
  221.         } else {
  222.         set vname [quote::Prettify $v]
  223.         }
  224.         if {$spelling} {
  225.         text::british vname
  226.         }
  227.         if {$flag_check && [lcontains allFlags $v]} {
  228.         if {[info tclversion] < 8.0} {
  229.             lappend args "-c" $vname $vv $l $t $r [expr {$t + 15}]
  230.         } else {
  231.             lappend args "-c" $vname $vv -font 2 $l $t $r [expr {$t + 15}]
  232.         }
  233.         incr t 15
  234.         continue
  235.         }
  236.         # attempt to indent correctly
  237.         set len [string length $vname] 
  238.         if {$len > 40} {
  239.         lappend args "-t" "$vname:" $l $t [expr {$r -30}] [expr {$t + $height}]
  240.         incr t 15
  241.         set indent 100
  242.         set tle ""
  243.         } elseif {$len > 17} {
  244.         set indent [expr {11 + 7 * $len}]
  245.         set tle {"-t" "$vname:" $l $t [expr {$l + $indent}] [expr {$t + $height}]}
  246.         } else {
  247.         set indent $lf
  248.         set tle {"-t" "$vname:" $l $t [expr {$l + $indent}] [expr {$t + $height}]}
  249.         }
  250.         
  251.         if {[info exists flag::list($v)]} {
  252.         incr t 5
  253.         eval lappend args $tle
  254.         set litems [flag::options $v]
  255.         if {[regexp "index" [lindex [set flag::list($v)] 0]]} {
  256.             # set item to index, making sure bad values don't error
  257.             if {[catch {lindex $litems $vv} vv]} { set vv [lindex $litems 0] }
  258.         }
  259.         lappend args "-m" [concat [list $vv] $litems] [expr {$l + $indent -2}] [expr {$t -2}] [expr {$r - 14}] [expr {$t + $height +1}]
  260.         incr t 17
  261.         } elseif {[regexp "Colou?r$" $v]} {
  262.         incr t 5
  263.         eval lappend args $tle
  264.         lappend args "-m" [concat [list $vv] ${alpha::colors}] [expr {$l + $indent -2}] [expr {$t -2}] [expr {$r - 14}] [expr {$t + $height +1}]
  265.         incr t 17
  266.         } elseif {[regexp "Mode$" $v]} {
  267.         incr t 5
  268.         eval lappend args $tle
  269.         if {$vv == ""} { set vv "<none>" }
  270.         lappend args "-m" [concat [list $vv] [concat "<none>" [mode::listAll]]] [expr {$l + $indent -2}] $t [expr {$r - 14}] [expr {$t + $height +1}]
  271.         incr t 17
  272.         } elseif {[regexp "Sig$" $v]} {
  273.         eval lappend args $tle
  274.         set vv [dialog::specialView::Sig $vv]
  275.         lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  276.         eval lappend args [dialog::buttonSet $rb $t Sig $v]
  277.         incr t 17
  278.         } elseif {[regexp "SearchPath$" $v]} {
  279.         eval lappend args $tle
  280.         set origt $t
  281.         if {$vv == ""} {
  282.             lappend args "-t" "No search paths currently set." \
  283.               [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  284.             incr t 17
  285.         } else {
  286.             set view {}
  287.             foreach ppath $vv {
  288.             lappend view [dialog::specialView::file $ppath]
  289.             incr t 17
  290.             }
  291.             lappend args "-t" [join $view "\r"] \
  292.               [expr {$l + $indent}] $origt $rb [expr {$t - 17 + $height +1}]
  293.         }
  294.         eval lappend args [dialog::buttonSet $rb $origt]
  295.         # Note: you can test the result of adding 'SearchPath $v' as two
  296.         # more arguments to dialog::buttonSet above.  The problem arises
  297.         # when we increase the number of paths - there isn't room in the
  298.         # dialog for more of them!
  299.         } elseif {[regexp "(Path|Folder)$" $v]} {
  300.         eval lappend args $tle
  301.         set vv [dialog::specialView::file $vv]
  302.         lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  303.         eval lappend args [dialog::buttonSet $rb $t Folder $v]
  304.         incr t 17
  305.         } elseif {[info exists flag::type($v)]} {
  306.         if {[set flag::type($v)] == "funnyChars"} {
  307.             set vv [quote::Display $vv]
  308.             set eh [expr {1 + [string length $vv] / 60}]
  309.             incr t [expr {7 * $eh}]
  310.             eval lappend args $tle
  311.             incr t [expr {5 -7 * $eh}]
  312.             lappend args "-e" $vv [expr {$l + $indent}] $t $r [expr {$t + $eh * $height}]
  313.             incr t [expr {5 + 17 * $eh}]
  314.         } else {
  315.             eval lappend args $tle
  316.             set vv [dialog::specialView::[set flag::type($v)] $vv]
  317.             lappend args "-t" $vv [expr {$l + $indent}] $t $rb [expr {$t + $height +1}]
  318.             eval lappend args [dialog::buttonSet $rb $t [set flag::type($v)] $v]            
  319.             incr t 17
  320.         }
  321.         } else {
  322.         set eh [expr {1 + [string length $vv] / 60}]
  323.         incr t [expr {7 * $eh}]
  324.         eval lappend args $tle
  325.         incr t [expr {5 -7 * $eh}]
  326.         lappend args "-e" $vv [expr {$l + $indent}] $t $r [expr {$t + $eh * $height}]
  327.         incr t [expr {5 + 17 * $eh}]
  328.         }
  329.     }
  330.     }
  331.     if {$dialogvar == ""} {return $args}
  332. }
  333.  
  334. proc dialog::multipage {title data} {
  335.     dialog::resetModified
  336.     global maxT dialog::_not_global_pkg dialog::_not_global_flag
  337.     # in case internal 'command-buttons' are used in the dialog
  338.     while 1 {
  339.     
  340.     set left 20   
  341.     
  342.     set names {}
  343.     set editItems {}
  344.     set cmd ""
  345.     set maxT 0
  346.     if {![info exists dialog::_not_global_pkg]} {
  347.         set data [lsort $data]
  348.     }
  349.     foreach arg $data {
  350.         if {[llength $arg] != 3} {error "Bad structure"}
  351.         set name [lindex $arg 0]
  352.         lappend names $name
  353.         # set the appropriate value of dialog::_not_global_flag
  354.         if {[info exists dialog::_not_global_pkg] \
  355.         && [lsearch -exact ${dialog::_not_global_pkg} ${name}modeVars] >= 0} {
  356.         set dialog::_not_global_flag ${name}modeVars
  357.         } else {
  358.         set dialog::_not_global_flag {}
  359.         }
  360.         set flags [lindex $arg 1]
  361.         set vars [lindex $arg 2]
  362.         lappend editItems [eval list $flags $vars]
  363.         eval lappend cmd "-n" [list [lindex $arg 0]] [dialog::flag $flags $vars]
  364.     }
  365.     
  366.     set buttons [dialog::okcancel $left maxT]
  367.     set height $maxT
  368.     # set the appropriate value of dialog::_not_global_flag
  369.     if {![info exists chosenName]} {
  370.         set chosenName [lindex $names 0]
  371.         if {[info exists dialog::_not_global_pkg] \
  372.         && [lsearch -exact ${dialog::_not_global_pkg} $chosenName] >= 0} {
  373.         set dialog::_not_global_flag $chosenName
  374.         } else {
  375.         set dialog::_not_global_flag {}
  376.         }
  377.     }
  378.     if {[info exists help]} {
  379.         set res [eval [concat dialog -w 480 -h $height [list -T $title] \
  380.           -t "Preferences:" 40 10 125 30 $buttons \
  381.           -b "Help" 410 10 460 28 \
  382.           [list -m [concat [list $chosenName] $names] 140 8 405 30] \
  383.           $cmd -help] [list [concat [list \
  384.           "Click here to save the current settings." \
  385.           "Click here to discard any changes you've made to the settings." \
  386.           "Click here to display textual help on each item in this dialog." \
  387.           "Use this popup menu, or the cursor keys to select a \
  388.           different page of preferences."] $help]]]
  389.     } else {
  390.         set res [eval [concat dialog -w 480 -h $height \
  391.           -t "Preferences:" 40 10 125 30 $buttons \
  392.           -b "Help" 410 10 460 28 \
  393.           [list -m [concat [list $chosenName] $names] 140 8 405 30] \
  394.           $cmd]]
  395.     }
  396.     
  397.     set chosenName [lindex $res 3]
  398.     # set the appropriate value of dialog::_not_global_flag
  399.     if {[info exists dialog::_not_global_pkg] \
  400.         && [lsearch -exact ${dialog::_not_global_pkg} ${chosenName}modeVars] >= 0} {
  401.         set dialog::_not_global_flag ${chosenName}modeVars
  402.     } else {
  403.         set dialog::_not_global_flag {}
  404.     }
  405.     if {[lindex $res 0]} {
  406.         return [list [lrange $res 4 end] [eval concat $editItems]]
  407.     } else {
  408.         if {[lindex $res 1]} {
  409.         unset dialog::_not_global_pkg
  410.         set dialog::_not_global_flag {}
  411.         error "Cancel chosen"
  412.         }
  413.         dialog::rememberChanges [list [lrange $res 4 end] [eval concat $editItems]]
  414.         # Either help, or some set or describe type button was pressed
  415.         # We need to ensure we remember anything the user has already
  416.         # changed.
  417.         if {[lindex $res 2]} {
  418.         # help pressed
  419.         set i [lsearch -exact $names [lindex $res 3]]
  420.         dialog::describe [lindex $editItems $i] "Description of [lindex $res 3]"
  421.         } else {
  422.         # a 'set...' button was pressed
  423.         dialog::handleSet [lrange $res 4 end] [eval concat $editItems]
  424.         }
  425.     }
  426.     # end of large while loop
  427.     }
  428. }
  429.  
  430. proc dialog::rememberChanges {values_items} {
  431.     set res [lindex $values_items 0]
  432.     set editItems [lindex $values_items 1]
  433.     unset values_items
  434.     foreach fset $editItems {
  435.     if {[llength $fset] > 1} {
  436.         set fset [lrange $fset 1 end]
  437.     }
  438.     foreach flag $fset {
  439.         set val [lindex $res 0]
  440.         set res [lrange $res 1 end]
  441.         # May need to 'catch' this postManipulate for Dominique's
  442.         # package changes.
  443.         dialog::postManipulate 0
  444.         dialog::modified $flag $val
  445.     }
  446.     }
  447. }
  448.  
  449. proc dialog::onepage {flags vars {title ""}} {
  450.     dialog::resetModified
  451.     global maxT
  452.     while 1 {
  453.     set left 20
  454.     set maxT 0
  455.     if {[info tclversion] < 8.0} {
  456.         set args [dialog::flag $flags $vars 20 10 $title]
  457.     } else {
  458.         set args [dialog::flag $flags $vars 20 10]
  459.     }
  460.     set height [expr {$maxT + 30}]
  461.     set buttons [dialog::okcancel $left maxT]
  462.     set height $maxT
  463.     if {[info exists help]} {
  464.         set res [eval [concat dialog -w 480 -h $height $buttons \
  465.           -T [list $title] -b "Help" 410 5 460 23 $args -help] \
  466.           [list [concat [list \
  467.           "Click here to save the current settings." \
  468.           "Click here to discard any changes you've made to the settings." \
  469.           "Click here to display textual help on each item in this dialog." \
  470.           ] $help]]]
  471.     } else {
  472.         set res [eval [concat dialog -w 480 -h $height $buttons \
  473.           -b "Help" 410 10 460 28 $args]]
  474.     }
  475.     
  476.     if {[lindex $res 0]} {
  477.         return [list [lrange $res 3 end] [concat $flags $vars]]
  478.     } else {
  479.         
  480.         if {[lindex $res 1]} {
  481.         error "Cancel chosen"
  482.         } 
  483.         dialog::rememberChanges [list [lrange $res 3 end] [concat $flags $vars]]
  484.         if {[lindex $res 2]} {
  485.         # help
  486.         dialog::describe [concat $flags $vars] $title
  487.         } else {
  488.         dialog::handleSet [lrange $res 3 end] [concat $flags $vars]
  489.         }
  490.     }
  491.     # big while loop end
  492.     }
  493.     
  494. }
  495.  
  496. if {[info tclversion] >= 8.0} {
  497. proc dialog::describe {vars {title ""}} {
  498.     if {$title == ""} {
  499.     set title "Preferences description"
  500.     }
  501.     global flag::list flag::type spelling alpha::colors \
  502.       dialog::_not_global_flag mode index::flags
  503.     if {[regsub {(modeVars)?$} ${dialog::_not_global_flag} "" vprefix]} {
  504.     append vprefix ","
  505.     }
  506.     cache::readContents index::prefshelp
  507.     set height 17
  508.     set lf 135
  509.     set l 20
  510.     set width 420
  511.     set r [expr {$l + $width}]
  512.     set rb [expr {$r -45}]
  513.     set args {}
  514.     set t 35
  515.     set height 0
  516.     set page 1
  517.     set pages {}
  518.     set lst {}
  519.     foreach vset $vars {
  520.     if {$t > 360} {
  521.         # make another page
  522.         eval lappend pages -n [list "Page $page"] $args
  523.         eval lappend lst [list $args]
  524.         set args {}
  525.         incr page
  526.         if {$t > $height} {set height $t}
  527.         set t 35
  528.     }
  529.     if {[llength $vset] > 1} {
  530.         incr t 5
  531.         if {[lindex $vset 0] != ""} {
  532.         lappend args "-t" "[lindex $vset 0]" [expr {$l -10}] $t $r [expr {$t +15}]
  533.         incr t 20
  534.         }
  535.         set vset [lrange $vset 1 end]
  536.     } else {
  537.         # Do this so that vars that have whitespace padding (used to
  538.         # force dialog position) are not stripped of that space in the
  539.         # next "foreach" statement
  540.         set vset [list [set vset]]
  541.     }
  542.     foreach v $vset {
  543.         set vv [dialog::getFlag $v]
  544.         if {[info exists name($v)]} {
  545.         set vname $name($v)
  546.         } else {
  547.         set vname [quote::Prettify $v]
  548.         }
  549.         if {$spelling} {
  550.         text::british vname
  551.         }
  552.         if {[info exists prefshelp($vprefix$v)]} {
  553.         append vname ": " [dialog::helpdescription $prefshelp($vprefix$v)]
  554.         } elseif {[info exists prefshelp($mode,$v)]} {
  555.         append vname ": " [dialog::helpdescription $prefshelp($mode,$v)]
  556.         } elseif {[lsearch -exact [set index::flags] $v] != -1} {
  557.         append vname ": " [dialog::helpdescription [dialog::packagehelp $v]]
  558.         } else {
  559.         append vname ": no description"
  560.         }
  561.         eval lappend args [dialog::text $vname $l t 60]
  562.     }
  563.     }
  564.     if {$page > 1} {
  565.     set t $height
  566.     set height [expr {$t + 40}]
  567.     for {set i 1} {$i <= $page} {incr i} {
  568.         lappend names "Page $i"
  569.     }
  570.     eval lappend pages [list -n "Page $page"] $args        
  571.     set res [eval [concat dialog -w 480 -h $height \
  572.       -t [list $title] 60 10 $width 30 \
  573.       -b "Ok" 30 [expr {$t + 10}] 95 [expr {$t +30}] \
  574.       [list -m [concat [list [lindex $names 0]] $names] 400 10 475 30] $pages]]
  575.     } else {
  576.     set height [expr {$t + 40}]
  577.     set res [eval [concat dialog -w 480 -h $height \
  578.       -t [list $title] 60 10 $width 30 \
  579.       -b "Ok" 30 [expr {$t + 10}] 95 [expr {$t +30}] $args]]
  580.     }
  581. }
  582. } else {
  583.     # old version for Alpha 7.x
  584.     proc dialog::describe {vars {title ""}} {
  585.     if {$title == ""} {
  586.         set title "Preferences description"
  587.     }
  588.     global flag::list flag::type spelling alpha::colors \
  589.       dialog::_not_global_flag mode index::flags
  590.     global defHeight
  591.     if {[regsub {(modeVars)?$} ${dialog::_not_global_flag} "" vprefix]} {
  592.         append vprefix ","
  593.     }
  594.     cache::readContents index::prefshelp
  595.     set height 17
  596.     set lf 135
  597.     set l 20
  598.     set width 420
  599.     set r [expr {$l + $width}]
  600.     set rb [expr {$r -45}]
  601.     set args {}
  602.     set t 35
  603.     set height [expr {$defHeight - 60}]
  604.     set page 1
  605.     set lst {}
  606.     foreach vset $vars {
  607.         if {[llength $vset] > 1} {
  608.         incr t 5
  609.         if {[lindex $vset 0] != ""} {
  610.             lappend args "-t" "[lindex $vset 0]" [expr {$l -10}] $t $r \
  611.                       [expr {$t +15}]
  612.             incr t 20
  613.         }
  614.         set vset [lrange $vset 1 end]
  615.         } else {
  616.         # Do this so that vars that have whitespace padding (used to
  617.         # force dialog position) are not stripped of that space in the
  618.         # next "foreach" statement
  619.         set vset [list [set vset]]
  620.         }
  621.         foreach v $vset {
  622.         set vv [dialog::getFlag $v]
  623.         if {[info exists name($v)]} {
  624.             set vname $name($v)
  625.         } else {
  626.             set vname [quote::Prettify $v]
  627.         }
  628.         if {$spelling} {
  629.             text::british vname
  630.         }
  631.         if {[info exists prefshelp($vprefix$v)]} {
  632.             append vname ": " [dialog::helpdescription \
  633.                     $prefshelp($vprefix$v)]
  634.         } elseif {[info exists prefshelp($mode,$v)]} {
  635.             append vname ": " [dialog::helpdescription $prefshelp($mode,$v)]
  636.         } elseif {[lsearch -exact [set index::flags] $v] != -1} {
  637.             append vname ": " [dialog::helpdescription \
  638.                      [dialog::packagehelp $v]]
  639.         } else {
  640.             append vname ": no description"
  641.         }
  642.         set newarg [dialog::text $vname $l t 60]
  643.         if {$t <= $height} {
  644.             eval lappend args $newarg
  645.         } else {
  646.             # make another page
  647.             eval lappend lst [list $args] 
  648.             incr page
  649.             set lngth [llength $newarg]
  650.             set disp [expr {[lindex $newarg 3] - 35}]
  651.             set bot [expr {$t - [lindex $newarg [expr {$lngth - 1}]]}]
  652.             set k 3
  653.             for {set i 3} {$i < $lngth} {incr i 6} {
  654.             # shift 'newarg' vertically.  The shifting is based 
  655.             # on 'newarg' build as '-x text h1 v1 h2 v2'.
  656.             set j [expr {$k + 2}]
  657.             set pntr [expr {[lindex $newarg $j] - $disp}]
  658.             if {$pntr > [expr {$height - $bot}]} {
  659.                 # page too long, split 'newarg'. 
  660.                 # The splitting is based on 'newarg' build as
  661.                 # -x text h1 v1 h2 v2.  It assumes that the elementary 
  662.                 # piece of text fits in a single page.
  663.                 set tmp [lrange $newarg 0 [expr {$k - 4}]]
  664.                 eval lappend lst [list $tmp] 
  665.                 incr page
  666.                 set newarg [lrange $newarg [expr {$k - 3}] end]
  667.                 set disp [expr {[lindex $newarg 3] - 35}]
  668.                 set pntr [expr {[lindex $newarg 5] - $disp}]
  669.                 set k 3
  670.                 set j 5
  671.             }
  672.             set newarg [lreplace $newarg $k $k \
  673.               [expr {[lindex $newarg $k] - $disp}]]
  674.             set newarg [lreplace $newarg $j $j $pntr]
  675.             incr k 6
  676.             }
  677.             if {![llength $newarg]} {
  678.             set t 35
  679.             set args {}
  680.             } else {
  681.             set t [expr {$t - $disp}]
  682.             set args $newarg
  683.             }        
  684.         }
  685.         }
  686.         
  687.     }
  688.     if {![llength $args]} {
  689.         incr page -1
  690.     } else {
  691.         lappend lst $args
  692.     }        
  693.     if {$page > 1} {
  694.         set t $height
  695.         set height [expr {$t + 40}]
  696.         for {set i 1} {$i <= $page} {incr i} {
  697.         eval lappend pages -n [list "Page $i"] [lindex $lst \
  698.                                   [expr {$i - 1}]]
  699.         lappend names "Page $i"
  700.         }
  701.         eval lappend pages -n [list "Page $page"] $args        
  702.         if {($page > 1) || \
  703.         [catch { set res [eval [concat dialog -w 480 -h $height \
  704.           -t [list $title] 60 10 $width 30 \
  705.           -b "Ok" 30 [expr {$t + 10}] 95 [expr {$t +30}] \
  706.           [list -m [concat [list [lindex $names 0]] $names] 400 10 475 30] \
  707.           $pages]]}]} {
  708.         # Dominque's code to work around Alpha 7.x problem with
  709.         # dialogs containing too much stuff.
  710.         set pgnmbr 0
  711.         set v1 [expr {$t + 10}]
  712.         set v2 [expr {$t +30}]
  713.         while 1 {
  714.             set pages [lindex $lst $pgnmbr]
  715.             set h1 230
  716.             set h2 250
  717.             set names {}
  718.             for {set i 1} {$i <= $page} {incr i} {
  719.             if {$i == [expr {$pgnmbr+ 1}]} {
  720.                 lappend names -t $i [expr {$h1 + 4}] $v1 $h2 $v2
  721.             } else {
  722.                 lappend names -b $i $h1 [expr {$v1 - 2}] \
  723.                   $h2 [expr {$v2 - 2}]
  724.             }
  725.             incr h1 25
  726.             incr h2 25
  727.             }
  728.             set res [eval [concat dialog -w 480 -h $height \
  729.               -t [list $title] 60 10 $width 30 -b "Ok" 30 $v1 95 $v2 \
  730.               -t {Choose\ Page:} 140 $v1 230 $v2 $names $pages]]
  731.             if {[lindex $res 0]} {
  732.             return
  733.             }
  734.             for {set i 1} {$i < $page} {incr i} {
  735.             if {[lindex $res $i]} {
  736.                 if {$i < [expr {$pgnmbr+ 1}]} {
  737.                 set pgnmbr [expr {$i - 1}] 
  738.                 } else {
  739.                 set pgnmbr $i
  740.                 }
  741.                 break
  742.             }
  743.             }
  744.         }
  745.         }
  746.     } else {
  747.         set height [expr {$t + 40}]
  748.         set res [eval [concat dialog -w 480 -h $height \
  749.           -t [list $title] 60 10 $width 30 \
  750.           -b "Ok" 30 [expr {$t + 10}] 95 [expr {$t +30}] $args]]
  751.     }
  752.     }
  753. }
  754.  
  755. proc dialog::helpdescription {hlp} {
  756.     set hlp [split $hlp |]
  757.     if {[llength $hlp] <= 1} {
  758.     return [lindex $hlp 0]
  759.     }
  760.     set res ""
  761.     for {set hi 0} {$hi < [llength $hlp]} {incr hi} {
  762.     set hitem [lindex $hlp $hi]
  763.     if {$hitem != ""} {
  764.         if {$hi == 0} {
  765.         regsub "click this box\\.? *" $hitem "turn this item on" hitem
  766.         } elseif {$hi == 2} {
  767.         regsub "click this box\\.? *" $hitem "turn this item off" hitem
  768.         }
  769.         append res $hitem ". "
  770.     }
  771.     }
  772.     return $res
  773. }
  774.  
  775. if {${alpha::platform} == "alpha"} {
  776.     set dialog::strlength 253
  777. } else {
  778.     set dialog::strlength 2000
  779. }
  780.  
  781. ## 
  782.  # -------------------------------------------------------------------------
  783.  # 
  784.  # "dialog::packagehelp" --
  785.  # 
  786.  #  Return help string useful for balloon help for a given package.
  787.  #  If 'balloon' is 1, we only allow 253 characters in each substring.
  788.  #  (Balloon help has trouble with large quantities...)
  789.  # -------------------------------------------------------------------------
  790.  ##
  791. proc dialog::packagehelp {pkg {balloon 0}} {
  792.     regsub -all "\[ \t\r\n\]+" [string trim [package::helpFile $pkg 1]] " " hlp
  793.     if {$balloon} {
  794.     global dialog::strlength
  795.     set hlp [string range $hlp 0 [set dialog::strlength]]
  796.     return "${hlp}||${hlp}"
  797.     } else {
  798.     return $hlp
  799.     }
  800. }
  801.  
  802. # ◊◊◊◊ Dialog utilities ◊◊◊◊ #
  803. proc dialog::handleSet {res names} {
  804.     # to account for sub-lists in the list of names
  805.     foreach n $names {
  806.     if {[llength $n] > 1} {
  807.         eval lappend newnames [lrange $n 1 end]
  808.     } else {
  809.         lappend newnames $n
  810.     }
  811.     }
  812.     set names $newnames
  813.     unset newnames
  814.     global flag::type
  815.     # a 'set…' button was pressed
  816.     for {set i 0} {$i < [llength $names]} {incr i} {
  817.     if {[lindex $res $i] == 1} {
  818.         set v [lindex $names $i]
  819.         if {[regexp "SearchPath$" $v]} {
  820.         dialog::specialSet::SearchPath $v
  821.         break
  822.         } elseif {[regexp "(Path|Folder)$" $v]} {
  823.         # this set… pressed
  824.         if {![catch {get_directory -p "New [quote::Prettify $v]"} newval]} {
  825.             dialog::modified $v $newval
  826.         }
  827.         break
  828.         } elseif {[info exists flag::type($v)]} {
  829.         dialog::specialSet::[set flag::type($v)] $v
  830.         break
  831.         } elseif {[regexp "Sig$" $v]} {
  832.         global $v
  833.         if {[info exists $v]} {
  834.             set newval [dialog::findApp $v [set $v]]
  835.         } else {
  836.             set newval [dialog::findApp $v]
  837.         }
  838.         if {$newval != ""} {
  839.             dialog::modified $v $newval
  840.         }
  841.         break
  842.         }  
  843.     }
  844.     }
  845. }
  846.  
  847. proc dialog::setFlag {name val} {
  848.     global dialog::_not_global_flag
  849.     if {${dialog::_not_global_flag} != ""} {
  850.     global ${dialog::_not_global_flag}
  851.     if {[array exists ${dialog::_not_global_flag}]} {
  852.         set ${dialog::_not_global_flag}($name) $val
  853.     } else {
  854.         global ${dialog::_not_global_flag}::${name}
  855.         set ${dialog::_not_global_flag}::${name} $val
  856.     }
  857.     } else {
  858.     global index::feature dialog::_is_global mode
  859.     if {[info exists index::feature($name)]} {
  860.         if {[info exists dialog::_is_global]} {
  861.         global global::features
  862.         if {$val} {
  863.             lunion global::features $name
  864.             package::activate $name
  865.         } else {
  866.             set global::features [lremove [set global::features] $name]
  867.             global mode
  868.             if {$mode != ""} {
  869.             if {![mode::isFeatureActive $mode $name]} {
  870.                 package::deactivate $name
  871.             }
  872.             } else {
  873.             package::deactivate $name
  874.             }
  875.         }
  876.         } else {
  877.         mode::adjustFeatures $name $val
  878.         }
  879.     } else {
  880.         global $name
  881.         set $name $val
  882.     }
  883.     }    
  884. }
  885.  
  886. proc dialog::getFlag {name} {
  887.     global dialog::_modified
  888.     if {[info exists dialog::_modified($name)]} { 
  889.     return [set dialog::_modified($name)] 
  890.     } else {
  891.     return [dialog::getOldFlag $name]
  892.     }
  893. }
  894.  
  895. proc dialog::getOldFlag {name} {
  896.     global dialog::_not_global_flag dialog::_not_global_pkg
  897.     # Added this block to handle flags and variables in dialog::_not_global_pkg
  898.     if {[info exists dialog::_not_global_pkg]} {
  899.     foreach pkg ${dialog::_not_global_pkg} {
  900.         global $pkg
  901.         if {[info exists ${pkg}($name)]} {
  902.         return [set ${pkg}($name)]
  903.         }
  904.     }
  905.     # For items in the miscellaneous page.
  906.     global $name
  907.     if {[info exists $name]} {
  908.         return [set $name]
  909.     }
  910.     }
  911.     if {${dialog::_not_global_flag} != ""} {
  912.     global ${dialog::_not_global_flag}
  913.     if {[array exists ${dialog::_not_global_flag}]} {
  914.         return [set ${dialog::_not_global_flag}($name)]
  915.     } elseif {[namespace_exists ${dialog::_not_global_flag}]} {
  916.         global ${dialog::_not_global_flag}::${name}
  917.         return [set ${dialog::_not_global_flag}::${name}]
  918.     } else {
  919.         error "No variable storage for '${dialog::_not_global_flag}' exists for flag $name"
  920.     }
  921.     }
  922.     global dialog::_is_global mode index::feature
  923.     if {[info exists dialog::_is_global]} {
  924.     global global::_vars global::features
  925.     if {[info exists global::_vars] \
  926.       && [set i [lsearch ${global::_vars} $name]] != -1} {
  927.         return [lindex ${global::_vars} [incr i]]
  928.     }
  929.     if {[info exists index::feature($name)]} {
  930.         return [expr {[lsearch -exact ${global::features} $name] != -1}]
  931.     }
  932.     } else {
  933.     if {[info exists index::feature($name)]} {
  934.         return [mode::isFeatureActive $mode $name]
  935.     }
  936.     }
  937.     global $name
  938.     if {[info exists $name]} { 
  939.     return [set $name]
  940.     } else { 
  941.     alertnote "Global variable '$name' in the dialog isn't set.\r\
  942.       I'll try to fix that."
  943.     return [set $name ""]
  944.     }
  945. }
  946.  
  947. proc dialog::is_global {script} {
  948.     global dialog::_is_global
  949.     set dialog::_is_global 1
  950.     catch "[list uplevel $script]"
  951.     unset dialog::_is_global
  952. }
  953. proc dialog::resetModified {} {
  954.     global dialog::_modified
  955.     if {[info exists dialog::_modified]} {
  956.     unset dialog::_modified
  957.     }
  958. }
  959.  
  960. ## 
  961.  # -------------------------------------------------------------------------
  962.  # 
  963.  # "dialog::adjust_flags" --
  964.  # 
  965.  #  This is used after the results are in from a prefs dialog, to 
  966.  #  make sure those results are stored in the correct places/variables.
  967.  #  
  968.  #  'global' items need to be stored in global variables
  969.  #  'arraynamespace' items are stored either inside the given array
  970.  #  (if it is an array) or inside the given namespace.
  971.  #  'arrayglobal' items are normally used for mode-vars, and are stored
  972.  #  both inside an array, and (when the mode is active) globally.
  973.  #  
  974.  #  The latter two items use the optional 'storage' argument to pass
  975.  #  the name of the array/namespace to be used.
  976.  # -------------------------------------------------------------------------
  977.  ##
  978. proc dialog::adjust_flags {how values_items {storage ""}} {
  979.     global flag::procs modifiedVars global::_vars index::feature \
  980.       modifiedArrayElements
  981.     set res [lindex $values_items 0]
  982.     set editItems [lindex $values_items 1]
  983.     unset values_items
  984.  
  985.     if {[string length $storage]} {
  986.     global $storage
  987.     }
  988.     
  989.     foreach fset $editItems {
  990.     if {[llength $fset] > 1} {
  991.         set fset [lrange $fset 1 end]
  992.     }
  993.     foreach flag $fset {
  994.         set val [lindex $res 0]
  995.         set res [lrange $res 1 end]
  996.         dialog::postManipulate
  997.         if {[info exists index::feature($flag)]} {
  998.         dialog::setFlag $flag $val
  999.         continue
  1000.         }
  1001.         switch -- $how {
  1002.         "global" {
  1003.             if {[info exists global::_vars] \
  1004.               && [set i [lsearch ${global::_vars} $flag]] != -1} {
  1005.             set orig [lindex ${global::_vars} [incr i]]
  1006.             if {$orig != $val} {
  1007.                 set global::_vars [lreplace ${global::_vars} $i $i $val]
  1008.                 lappend warn_global $flag
  1009.                 lappend modifiedVars $flag
  1010.             }
  1011.             } else {
  1012.             global $flag
  1013.             set orig [set $flag]
  1014.             if {$orig != $val} {
  1015.                 set $flag $val
  1016.                 lappend modifiedVars $flag
  1017.             }
  1018.             }
  1019.         }
  1020.         "arraynamespace" {
  1021.             # it's a package which keeps its vars in the array
  1022.             # or in a namespace.
  1023.             if {[array exists $storage]} {
  1024.             if {[set orig [set ${storage}($flag)]] != $val} {
  1025.                 set ${storage}($flag) $val
  1026.                 lappend modifiedArrayElements [list $flag $storage]
  1027.             }
  1028.             } else {
  1029.             global ${storage}::$flag
  1030.             if {[set orig [set ${storage}::$flag]] != $val} {
  1031.                 set ${storage}::$flag $val
  1032.                 lappend modifiedVars ${storage}::$flag
  1033.             }
  1034.             }
  1035.         }
  1036.         "arrayglobal" {
  1037.             # modes keep a copy of their vars at the global 
  1038.             # level when active
  1039.             global $flag
  1040.             if {[set orig [set $flag]] != $val} {
  1041.             set $flag $val
  1042.             set ${storage}($flag) $val
  1043.             lappend modifiedArrayElements [list $flag $storage]
  1044.             }
  1045.         }
  1046.         }
  1047.         # End of switch
  1048.         if {$orig != $val} {
  1049.         if {[info exists flag::procs($flag)]} {
  1050.             set proc [set flag::procs($flag)]
  1051.             if {([info procs $proc] != "") && ([llength [info args $proc]] == 0)} {
  1052.             eval $proc
  1053.             } else {
  1054.             eval $proc [list $flag]
  1055.             }
  1056.         }
  1057.         }
  1058.     }
  1059.     }
  1060.     if {[info exists warn_global]} {
  1061.     if {[llength $warn_global] == 1} {
  1062.         set msg "is a global pref"
  1063.     } else {
  1064.         set msg "are global prefs"
  1065.     }
  1066.     alertnote "You modified [join $warn_global {, }] which $msg,\
  1067.       but currently over-ridden by mode-specific values.  If you meant to\
  1068.       modify the latter values, use the mode prefs dialog."
  1069.     }
  1070. }
  1071.  
  1072. proc dialog::postManipulate {{modify 1}} {
  1073.     global flag::list flag::type
  1074.     upvar flag f
  1075.     upvar val v
  1076.     
  1077.     if {[info exists flag::list($f)]} {
  1078.     switch -- [lindex [set l [set flag::list($f)]] 0] {
  1079.         "index" {
  1080.         set v [lsearch -exact [lindex $l 1] $v]
  1081.         }
  1082.         "varindex" {
  1083.         set itemv [lindex $l 1]
  1084.         global $itemv
  1085.         set v [lsearch -exact [set $itemv] $v]
  1086.         }
  1087.     }
  1088.     }
  1089.     if {$v == "<none>" && [regexp "Mode$" $f]} { set v "" }
  1090.     # This check also captures any 'dialog::modified' items
  1091.     # This allows flags which are somehow already set by the
  1092.     # dialog (for instance if called recursively, or if set by embedded
  1093.     # 'Set…' buttons) to be registered as modifed by our calling procedure.
  1094.     if {[regexp "(Path|Folder|Sig)$" $f]} {
  1095.     set v [dialog::getFlag $f]
  1096.     } elseif {[info exists flag::type($f)]} {
  1097.     switch -- [set flag::type($f)] {
  1098.         "binding" {
  1099.         # setup the changed binding
  1100.         set old [dialog::getOldFlag $f]
  1101.         set v [dialog::getFlag $f]
  1102.         if {$modify && ($old != $v)} {
  1103.             global flag::binding
  1104.             if {[info exists flag::binding($f)]} {
  1105.             set m [lindex [set flag::binding($f)] 0]
  1106.             if {[set proc [lindex [set flag::binding($f)] 1]] == 1} {
  1107.                 set proc $f
  1108.             }
  1109.             catch "unBind [keys::toBind $old] [list $proc] $m"
  1110.             catch "Bind [keys::toBind $v] [list $proc] $m"
  1111.             }
  1112.         }
  1113.         }
  1114.         "funnyChars" {
  1115.         set v [quote::Undisplay $v]
  1116.         }
  1117.         default {
  1118.         set v [dialog::getFlag $f]
  1119.         }
  1120.     }
  1121.     }
  1122. }
  1123.  
  1124. proc dialog::modified {name val {type ""}} {
  1125.     global dialog::_modified
  1126.     set dialog::_modified($name) $val
  1127.     if {[string length $type]} {
  1128.     # We have some code registered which would like to know what
  1129.     # changed.  In Alphatk, and in the future in Alpha also, this
  1130.     # will be used to update dialog items from 'Set...' buttons
  1131.     # automatically, without having to destroy the dialog.
  1132.     hook::callAll dialog modified $name $val [dialog::specialView::$type $val]
  1133.     }
  1134. }
  1135.  
  1136. # When a dialog item is modified, and appropriate code has been
  1137. # registered, this procedure is called.  The effect of
  1138. # 'eval $dialItemSetCmd [list $view]' should be to modify the
  1139. # dialog in place, changing the required item.  For the moment
  1140. # the 'var' and 'val' parameters are ignored.
  1141. proc dialog::itemSetExisting {dialItemSetCmd var val view} {
  1142.     #tclLog "dialog::itemSetExisting $dialItemSetCmd $var $val $view"
  1143.     eval $dialItemSetCmd [list $view]
  1144. }
  1145.  
  1146. # Dialog code internal to Alpha can call this procedure when a 'set...'
  1147. # button is pressed to modify the dialog in place.  The 'cmd' is the
  1148. # command registered with the '-set' flag, and 'dialItemSetCmd' is a
  1149. # command which will be used in the procedure 'dialog::itemSetExisting'
  1150. # above.  These item-set cmds must be created and removed by the
  1151. # dialog code when appropriate.
  1152. proc dialog::itemSet {dialItemSetCmd cmd} {
  1153.     #tclLog "dialog::itemSet $dialItemSetCmd $cmd"
  1154.     hook::register dialog [list dialog::itemSetExisting $dialItemSetCmd] modified
  1155.     namespace eval :: $cmd
  1156.     hook::deregister dialog [list dialog::itemSetExisting $dialItemSetCmd] modified
  1157. }
  1158.  
  1159. # Used on modified mode flags.
  1160. set flag::procs(stringColor) "stringColorProc"
  1161. set flag::procs(commentColor) "stringColorProc"
  1162. set flag::procs(keywordColor) "stringColorProc"
  1163. set flag::procs(funcColor) "stringColorProc"
  1164. set flag::procs(sectionColor) "stringColorProc"
  1165. set flag::procs(bracesColor) "stringColorProc"
  1166.  
  1167. proc global::updateHelperFlags {} {
  1168.     uplevel #0 {
  1169.     set "flagPrefs(Helper Applications)" {}
  1170.     set "varPrefs(Helper Applications)" [lsort -ignore [info globals *Sig]]
  1171.     }
  1172. }
  1173.  
  1174. proc global::updatePackageFlags {} {
  1175.     global flagPrefs varPrefs allFlags modeVars allVars
  1176.     # flags can be in either flagPrefs or varPrefs if we're grouping
  1177.     # preferences according to function
  1178.     set all {}
  1179.     set flagPrefs(Packages) {}
  1180.     set varPrefs(Packages) {}
  1181.     foreach v [array names flagPrefs] {
  1182.     eval lappend all $flagPrefs($v)
  1183.     if {[info exists varPrefs($v)]} {
  1184.         if {[regexp {[{}]} $varPrefs($v)]} {
  1185.         # we're grouping
  1186.         foreach i $varPrefs($v) {
  1187.             if {[llength $i] > 1} {
  1188.             eval lappend all [lrange $i 1 end]
  1189.             } else {
  1190.             lappend all $i
  1191.             }
  1192.         }
  1193.         } else {
  1194.         eval lappend all $varPrefs($v)
  1195.         }
  1196.     }
  1197.     }
  1198.     foreach f $allFlags {
  1199.     if {([lsearch $modeVars $f] < 0)} {
  1200.         if {[lsearch -exact $all $f] == -1} {
  1201.         lappend flagPrefs(Packages) $f
  1202.         }
  1203.     }
  1204.     }
  1205.     
  1206.     foreach f $allVars {
  1207.     if {([lsearch $modeVars $f] < 0)} {
  1208.         if {[lsearch -exact $all $f] == -1} {
  1209.         if {[regexp {Sig$} $f]} {
  1210.             lappend "varPrefs(Helper Applications)" $f
  1211.         } else {
  1212.             lappend varPrefs(Packages) $f
  1213.         }
  1214.         }
  1215.     }
  1216.     }
  1217. }
  1218.  
  1219. #================================================================================
  1220.  
  1221. proc maxListItemLength {l} {
  1222.     set m 0
  1223.     foreach item $l {
  1224.     if {[set mm [string length $item]] > $m} { set m $mm }
  1225.     }
  1226.     return $m
  1227. }
  1228.  
  1229. proc stringColorProc {flag} {
  1230.     global $flag mode
  1231.     
  1232.     if {[set $flag] == "none"} {
  1233.         set $flag "foreground"
  1234.     }
  1235.     if {$flag == "stringColor"} {
  1236.         regModeKeywords -a -s $stringColor $mode
  1237.     } elseif {$flag == "commentColor"} {
  1238.         regModeKeywords -a -c $commentColor $mode
  1239.     } elseif {$flag == "funcColor"} {
  1240.         regModeKeywords -a -f $funcColor $mode
  1241.     } elseif {$flag == "bracesColor"} {
  1242.         regModeKeywords -a -I $bracesColor $mode
  1243.     } elseif {($flag == "keywordColor") || ($flag == "sectionColor")} {
  1244.         alertnote "Change in keyword color will take effect after Alpha restarts."
  1245.         return
  1246.     } else {
  1247.         alertnote "Change in $flag color will take effect after Alpha restarts."
  1248.         return
  1249.     }
  1250.     refresh
  1251. }
  1252.  
  1253. # ◊◊◊◊ Dialog sub-items ◊◊◊◊ #
  1254.  
  1255. if {[info tclversion] <= 8.0} {
  1256.     proc dialog::buttonSet {x y args} {
  1257.     return [list -b Set… $x $y [expr {$x + 45}] [expr {$y + 15}]]
  1258.     }
  1259. } else {
  1260.     # Alphatk and Alpha8 can cope with setting dialog elements in place, via an extra
  1261.     # '-set' flag.  This means we don't need to destroy and recreate the entire dialog
  1262.     # when using a 'Set...' button.
  1263.     proc dialog::buttonSet {x y args} {
  1264.     if {[llength $args]} {
  1265.         return [list -b Set… -set [list [eval list [list dialog::specialSet::[lindex $args 0]] [lrange $args 1 end]] -1] \
  1266.           $x $y [expr {$x + 45}] [expr {$y + 15}]]
  1267.     } else {
  1268.         return [list -b Set… $x $y [expr {$x + 45}] [expr {$y + 15}]]
  1269.     }
  1270.     }
  1271. }
  1272.  
  1273. proc dialog::okcancel {x yy {vertical 0} {ok OK} {cancel Cancel}} {
  1274.     upvar $yy y
  1275.     set i [dialog::button "$ok" $x y]
  1276.     if {!$vertical} {
  1277.     incr y -30
  1278.     incr x 80
  1279.     }
  1280.     eval lappend i [dialog::button "$cancel" $x y]
  1281.     return $i
  1282. }
  1283.  
  1284. proc dialog::menu {x yy item {def "def"} {requestedWidth 0}} { 
  1285.     upvar $yy y
  1286.     set m [concat [list $def] $item]
  1287.     if {$requestedWidth == 0} {
  1288.     set popUpWidth 340
  1289.     } else {
  1290.     set popUpWidth $requestedWidth 
  1291.     }
  1292.     
  1293.     if {[info tclversion] < 8.0} {
  1294.     set res [list -m $m $x $y [expr {$x + $popUpWidth}] [expr {$y +20}]]
  1295.     incr y 20
  1296.     } else {
  1297.     incr y -1
  1298.     set res [list -m $m $x $y [expr {$x + $popUpWidth}] [expr {$y +19}]]
  1299.     incr y 21
  1300.     }
  1301.     return $res
  1302. }
  1303. ## 
  1304.  # -------------------------------------------------------------------------
  1305.  # 
  1306.  # "dialog::button" --
  1307.  # 
  1308.  #  Create a dialog string encoding one or more buttons.  'name' is the
  1309.  #  name of the button ("Ok" etc), x is the x position, or if x is null,
  1310.  #  then we use the variable called 'x' in the calling procedure.  yy is
  1311.  #  the name of a variable containing the y position of the button, which
  1312.  #  will be incremented by this procedure.  if args is non-null, it
  1313.  #  contains further name-x-yy values to be lined up next to this button.
  1314.  #  For sequences of default buttons, a spacing of '80' is usual, but
  1315.  #  it's probably best if you just set the 'x' param to "" and let this
  1316.  #  procedure calculate them for you.  See dialog::yesno for a good
  1317.  #  example of calling this procedure.
  1318.  # -------------------------------------------------------------------------
  1319.  ##
  1320. proc dialog::button {name x yy args} { 
  1321.     upvar $yy y
  1322.     if {$x == ""} {
  1323.     unset x
  1324.     upvar x x
  1325.     }
  1326.     set add 65
  1327.     if {[set i [expr {[string length $name] - 7}]] > 0} { 
  1328.     incr add [expr {$i * 7}]
  1329.     }
  1330.     set res [list -b $name $x $y [expr {$x +$add}] [expr {$y +20}]]
  1331.     incr x $add
  1332.     incr x 15
  1333.     if {[llength $args]} {
  1334.     eval lappend res [eval dialog::button $args]
  1335.     return $res
  1336.     }
  1337.     incr y 30
  1338.     return $res
  1339. }
  1340.  
  1341. proc dialog::title {name w} {
  1342.     set l [expr {${w}/2 - 4 * [string length $name]}]
  1343.     if {$l < 0} {set l 0}
  1344.     if {[info tclversion] < 8.0} {
  1345.     return [list -t $name $l 10 [expr {$w - $l}] 25]
  1346.     } else {
  1347.     return [list -T $name]
  1348.     }
  1349. }
  1350.  
  1351. ## 
  1352.  # -------------------------------------------------------------------------
  1353.  # 
  1354.  # "dialog::text" --
  1355.  # 
  1356.  #  Creates a text box wrapping etc the text to fit appropriately.
  1357.  #  In the input text 'name', "\r" is used as a paragraph delimiter,
  1358.  #  and "\n" is used to force a linebreak.  Paragraphs have a wider
  1359.  #  spread.
  1360.  # -------------------------------------------------------------------------
  1361.  ##
  1362. proc dialog::text {name x yy {split 0} args} {
  1363.     upvar $yy y
  1364.     if {$split <= 0 || ![string length $name]} {
  1365.     if {$split < 0} {
  1366.         set height [expr {15*[lindex $args 0]}]
  1367.         set res [list -t $name $x $y [expr {$x - $split}] \
  1368.           [incr y $height]]
  1369.         incr y 3
  1370.     } else {
  1371.         set res [list -t $name $x $y [expr {$x + 7 * [string length $name]}] \
  1372.           [expr {$y +15}]]
  1373.         incr y 18
  1374.     }
  1375.     } else {
  1376.     global fillColumn dialog::strlength
  1377.     if {[info exists fillColumn]} {
  1378.         set f $fillColumn
  1379.     }
  1380.     set fillColumn $split
  1381.     set name [string trim $name]
  1382.     set paragraphList [split $name "\r"]
  1383.     foreach para $paragraphList {
  1384.         set lines ""
  1385.         foreach line [split $para "\n"] {
  1386.         lappend lines [breakIntoLines $line]
  1387.         }
  1388.         set lines [join $lines "\r"]
  1389.         set curline {}
  1390.         set curlinecount 0
  1391.         set curmax 0
  1392.         foreach line [split $lines "\r"] {
  1393.         # Each '-t' dialog item can only be 255 characters long, and in Alpha 7
  1394.         # there are a limited number or total possible dialog items, so we try
  1395.         # to squash as much as possible into one -t item.
  1396.         if {([string length $curline] + [string length $line]) < [set dialog::strlength]} {
  1397.             if {[string length $curline]} {append curline "\r"}
  1398.             append curline $line
  1399.             incr curlinecount
  1400.             set xx [expr {8 * [string length $line]}]
  1401.             if {$xx > $curmax} { set curmax $xx }
  1402.         } else {
  1403.             eval lappend res [list -t $curline $x $y \
  1404.               [expr {$x + 4 + $curmax}] [expr {$y + 16 * $curlinecount -3}]]
  1405.             incr y [expr {16 * $curlinecount}]
  1406.             set curline $line
  1407.             set curlinecount 1
  1408.             set curmax [expr {8 * [string length $line]}]
  1409.         }
  1410.         }
  1411.         # handle the last item.
  1412.         eval lappend res [list -t $curline $x $y \
  1413.           [expr {$x + 4 + $curmax}] [expr {$y + 17 * $curlinecount -3}]]
  1414.         incr y [expr {16 * $curlinecount}]
  1415.         incr y 10
  1416.     }
  1417.     if {[info exists f]} {
  1418.         set fillColumn $f
  1419.     } else {
  1420.         unset fillColumn
  1421.     }
  1422.     if {![info exists res]} {
  1423.         set res [list -t $name $x $y [expr {$x + 7 * [string length $name]}] \
  1424.           [expr {$y +15}]]
  1425.         incr y 18
  1426.     }
  1427.     }
  1428.     return $res
  1429. }
  1430. proc dialog::edit {name x yy chars {rows 1}} {
  1431.     upvar $yy y
  1432.     set res [list -e $name $x $y [expr {$x + 10 * $chars}] [expr {$y + 15 * $rows}]]
  1433.     incr y [expr {5 + 15*$rows}]
  1434.     return $res
  1435. }
  1436. proc dialog::textedit {name default x yy chars {height 1} {horiz 0}} {
  1437.     upvar $yy y
  1438.     set xx [dialog::_reqWidth $name]
  1439.     set res [list -t $name $x $y [expr {$x + $xx}]\
  1440.       [expr {$y +16}] -e $default]
  1441.     if {$horiz} {
  1442.     incr x $horiz
  1443.     } else {
  1444.     incr y 20
  1445.     }
  1446.     lappend res $x $y [expr {$x + 10 * $chars}] \
  1447.       [expr {$y + 16*$height}]
  1448.     incr y [expr {4 + 16*$height}]
  1449.     return $res
  1450. }
  1451.  
  1452. if {[info tclversion] < 8.0} {
  1453.     proc dialog::checkbox {name default x yy} {
  1454.     upvar $yy y
  1455.     set res [list -c $name $default $x $y]
  1456.     lappend res [expr {$x + [dialog::_reqWidth $name]}] [expr {$y +15}]
  1457.     incr y 18
  1458.     return $res
  1459.     }
  1460. } else {
  1461.     proc dialog::checkbox {name default x yy} {
  1462.     upvar $yy y
  1463.     set res [list -c $name $default -font 2 $x $y]
  1464.     lappend res [expr {$x + [dialog::_reqWidth $name]}] [expr {$y +15}]
  1465.     incr y 18
  1466.     return $res
  1467.     }
  1468. }
  1469.  
  1470. if {${alpha::platform} == "alpha"} {
  1471.     proc dialog::_reqWidth {args} {
  1472.     set w 0
  1473.     foreach name $args {
  1474.         set c [regsub -all -nocase {[wm]} $name "" ""]
  1475.     set d [regsub -all {[ iIl',;:.]} $name "" ""]
  1476.     set len [expr {10 * [string length $name] + 6 * $c - 5 * $d}]
  1477.     if {[string length $name] < 7} {incr len 6}
  1478.     if {$len > $w} {
  1479.         set w $len
  1480.         }
  1481.     }
  1482.     return $w
  1483.     }
  1484. } else {
  1485.     proc dialog::_reqWidth {args} {return 0}
  1486. }
  1487.  
  1488.  
  1489. # ◊◊◊◊ Manipulation of special pref types ◊◊◊◊ #
  1490.  
  1491. namespace eval dialog::specialView {}
  1492. namespace eval dialog::specialSet {}
  1493.  
  1494. proc dialog::specialView::binding {key} {
  1495.     append key1 [keys::modifiersTo $key "verbose"]
  1496.     append key1 [keys::verboseKey $key]
  1497.     if {$key1 == ""} { return "<no binding>" }
  1498.     return $key1
  1499. }
  1500.  
  1501. proc dialog::specialSet::binding {v {menu 0}} {
  1502.     # Set… pressed
  1503.     set oldB [dialog::getFlag $v]
  1504.     if {![catch {dialog::getAKey [quote::Prettify $v] $oldB $menu} newKey] && $newKey != $oldB} {
  1505.     dialog::modified $v $newKey binding
  1506.     }
  1507. }
  1508.  
  1509. proc dialog::specialSet::Sig {v} {
  1510.     set old [dialog::getFlag $v]
  1511.     set newval [dialog::findApp $v $old]
  1512.     if {($newval != "") && ($newval != $old)} {
  1513.     dialog::modified $v $newval Sig
  1514.     }
  1515. }
  1516.  
  1517. proc dialog::specialSet::Folder {v} {
  1518.     global alpha::platform
  1519.     if {${alpha::platform} == "alpha"} {
  1520.     if {![catch {get_directory -p "New [quote::Prettify $v]"} newval]} {
  1521.         dialog::modified $v $newval Folder
  1522.     }
  1523.     } else {
  1524.     set old [dialog::getFlag $v]
  1525.     if {![catch {get_directory -p "New [quote::Prettify $v]" $old} newval]} {
  1526.         dialog::modified $v $newval Folder
  1527.     }
  1528.     }
  1529. }
  1530.  
  1531. proc dialog::specialView::menubinding {key} {
  1532.     dialog::specialView::binding $key
  1533. }
  1534.  
  1535. proc dialog::specialSet::menubinding {v} {
  1536.     dialog::specialSet::binding $v 1
  1537. }
  1538.  
  1539. proc dialog::specialView::SearchPath {vv} {
  1540.     if {[llength $vv]} {
  1541.     foreach ppath $vv {
  1542.         lappend view [dialog::specialView::file $ppath]
  1543.     }
  1544.     return [join $view "\r"]
  1545.     } else {
  1546.     return "No search paths currently set."
  1547.     }
  1548. }
  1549.  
  1550. proc dialog::specialView::Sig {vv} {
  1551.     if {$vv != ""} {
  1552.     if {[catch {nameFromAppl $vv} path]} {
  1553.         return "Unknown application with sig '$vv'"
  1554.     } else {
  1555.         return [dialog::specialView::file $path]
  1556.     }
  1557.     }
  1558.     return ""
  1559. }
  1560.  
  1561. proc dialog::specialView::Folder {vv} {
  1562.     dialog::specialView::file $vv
  1563. }
  1564.  
  1565. proc dialog::specialView::io-file {vv} {
  1566.     dialog::specialView::file $vv
  1567. }
  1568.  
  1569. proc dialog::specialView::file {vv} {
  1570.     if {[set sl [string length $vv]] > 33} {
  1571.     set vv "[string range $vv 0 8]...[string range $vv [expr {$sl -21}] end]"
  1572.     }
  1573.     return $vv
  1574. }
  1575. proc dialog::specialView::url {vv} {
  1576.     if {[set sl [string length $vv]] > 33} {
  1577.     set vv "[string range $vv 0 8]...[string range $vv [expr {$sl -21}] end]"
  1578.     }
  1579.     return $vv
  1580. }
  1581. proc dialog::specialSet::file {v} {
  1582.     # Set… pressed
  1583.     set old [dialog::getFlag $v]
  1584.     if {![catch {getfile [quote::Prettify "New $v"] $old} ff] \
  1585.       && $ff != $old} {
  1586.     dialog::modified $v $ff file
  1587.     }
  1588. }
  1589. proc dialog::specialSet::url {v} {
  1590.     # Set… pressed
  1591.     set old [dialog::getFlag $v]
  1592.     if {![catch {dialog::getUrl "New URL for [quote::Prettify $v]" $old} ff] \
  1593.       && $ff != $old} {
  1594.     dialog::modified $v $ff url
  1595.     }
  1596. }
  1597.  
  1598. proc dialog::specialSet::io-file {v} {
  1599.     # Set… pressed
  1600.     set old [dialog::getFlag $v]
  1601.     if {![catch {putfile [quote::Prettify "New $v"] $old} ff] \
  1602.       && $ff != $old} {
  1603.     dialog::modified $v $ff io-file
  1604.     }
  1605. }
  1606. proc dialog::specialSet::SearchPath {v} {
  1607.     # Set… pressed
  1608.     set res [buttonAlert "Perform what action to one of the [quote::Prettify $v]s" "Add" "Remove" "Change" "Cancel"]
  1609.     switch -- $res {
  1610.     "Add" {
  1611.         # add one
  1612.         if {![catch {get_directory -p "New [quote::Prettify $v]"} newval]} {
  1613.         set newval [concat [dialog::getFlag $v] [list $newval]] 
  1614.         dialog::modified $v $newval SearchPath
  1615.         }
  1616.     }
  1617.     "Remove" {
  1618.         if {![catch {set remove [listpick -p "Remove which items from [quote::Prettify $v]" -l [dialog::getFlag $v]]}]} {
  1619.         # remove them
  1620.         set newval [lremove -l [dialog::getFlag $v] $remove] 
  1621.         dialog::modified $v $newval SearchPath
  1622.         }
  1623.     }
  1624.     "Change" {
  1625.         if {![catch {set change [listpick -p "Change which item from [quote::Prettify $v]" [dialog::getFlag $v]]}]} {
  1626.         # change it
  1627.         if {![catch {get_directory -p "Replacement [quote::Prettify $v]:"} newval]} {
  1628.             set old [dialog::getFlag $v]
  1629.             set i [lsearch -exact $old $change]
  1630.             set old [lreplace $old $i $i $newval]
  1631.             dialog::modified $v $old SearchPath
  1632.         }
  1633.         }
  1634.     }
  1635.     }
  1636. }
  1637.  
  1638.  
  1639.  
  1640.  
  1641.  
  1642.